home *** CD-ROM | disk | FTP | other *** search
/ Point Programming 1 / PPROG1.ISO / pascal / swag / printing.swg / 0031_Bar Code Matrix Printers.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-27  |  4.4 KB  |  141 lines
  1. {
  2. From: MAYNARD PHILBROOK
  3. Subj: Re: bar codes
  4. ---------------------------------------------------------------------------
  5.  HB> I'm in need of bar code type code.   I want to print custom bar codes
  6.  HB> and be able to scan them into an application.  I also want to be able
  7.  HB> to do this directly from my application, not via a third party or a tsr
  8.  HB> program.
  9. }
  10.  
  11. {$F-,D-,S-,R-,V-,I-}
  12. {  Prints 3 Of 9 Bar Codes other wise known as Code 39 }
  13. {  May only work on EPSON or IBM Dot Matrix Printer !! }
  14. Uses   Printer;
  15. {$V-}
  16. Const           { Set up Defalt Settings }
  17.        Resolution:Byte = 2;            { Vertical Grid Width per Line }
  18.         Hight    :Byte = 3;            { Number of rows to Print }
  19.         Passes    :Byte = 2;           { Number for Passing for Darkness }
  20.         Density   :Byte = 1;            { Printer Graphic Mode L or Z }
  21.     Graphic_Mode:Array[1..2] of String[1] = ('L','Z');
  22.     grid :array[0..43] of string[12] =
  23.   ('110100101011',  {1}
  24.    '101100101011',  {2}
  25.    '110110010101',  {3}
  26.    '101001101011',  {4}
  27.    '110100110101',  {5}
  28.    '101100110101',  {6}
  29.    '101001011011',  {7}
  30.    '110100101101',  {8}
  31.    '101100101101',  {9}
  32.    '101001101101',  {0}
  33.    '110101001011',  {A}
  34.    '101101001011',  {B}
  35.    '110110100101',  {C}
  36.    '101011001011',  {D}
  37.    '110101100101',  {E}
  38.    '101101100101',  {F}
  39.    '101010011011',  {G}
  40.    '110101001101',  {H}
  41.    '101101001101',  {I}
  42.    '101011001101',  {J}
  43.    '110101010011',  {K}
  44.    '101101010011',  {L}
  45.    '110110101001',  {M}
  46.    '101011010011',  {N}
  47.    '110101101001',  {O}
  48.    '101101101001',  {P}
  49.    '101010110011',  {Q}
  50.    '110101011001',  {R}
  51.    '101101011001',  {S}
  52.    '101011011001',  {T}
  53.    '110010101011',  {U}
  54.    '100110101011',  {V}
  55.    '110011010101',  {W}
  56.    '100101101011',  {X}
  57.    '110010110101',  {Y}
  58.    '100110110101',  {Z}
  59.    '100101011011',  {-}
  60.    '110010101101',  {.}
  61.    '100110101101',  { }
  62.    '100101101101',  {*}
  63.    '100100100101',  {'$'}
  64.    '100100101001',  {/}
  65.    '100101001001',  {+}
  66.    '101001001001');  {%}
  67. Function Get_Grid(Yup:Char):String;   { Translations Function }
  68. Var
  69. PT     :Word;
  70. Begin
  71.        Get_Grid := '';
  72.        Case Yup Of
  73.         '1'..'9':Get_Grid := Grid[ Ord( Yup) -$31];
  74.         '0'    :Get_Grid := Grid[9];
  75.         'A'..'Z':Get_Grid := Grid[10+Ord(Yup)-65];
  76.          '-'   :Get_Grid := Grid[36];
  77.          '.'   :Get_grid := Grid[37];
  78.          ' '   :Get_Grid := Grid[38];
  79.          '*'   :Get_Grid := Grid[39];
  80.          '$'   :Get_Grid := Grid[40];
  81.          '/'   :Get_Grid := Grid[41];
  82.          '+'   :Get_Grid := Grid[42];
  83.          '%'   :Get_Grid := Grid[43];
  84.          End;
  85. End;
  86. Procedure Send_Char(Yup :Char);
  87. Var
  88. Hold   :String;
  89. L, G   :Word;
  90. Out_Bar :Byte;
  91. Begin
  92.  
  93.  Hold := Get_Grid(Upcase(Yup));
  94.  If Hold <> '' Then
  95.   Begin
  96.    Write(Lst,#27,Graphic_Mode[ Density ]);         { Printer in Graph Mode }
  97.    Write(Lst,Char((Resolution * 12)+Resolution),#0); { How many Bytes ?}
  98.    For L := 1 To 12 Do   { All 12 Chars }
  99.     Begin
  100.      If Hold[L] ='1' Then Out_bar := 255 Else Out_bar := 0;
  101.      For G := 1 To Resolution Do Write(Lst, Char(Out_Bar));
  102.     End;
  103.    For L := 1 To Resolution Do Write(Lst, #0); { Charactor Separator }
  104.   End;
  105. End;
  106.  
  107. Var
  108.  Number_IN :String[15];
  109.  L,LC, DS  :Word;
  110.  T        :Byte;
  111. Begin
  112.  Val(ParamStr(1), T, DS        );   { Adjust Parameters if Needed }
  113.  If DS = 0 Then Resolution := T;    { Width Ratio }
  114.  Val(ParamStr(2), T, DS );
  115.  If DS = 0 Then Hight := T;         { Vertical Size of Label }
  116.  Val(ParamStr(3), T, DS );
  117.  If DS = 0 THen Passes := T;        { For Darkness adjust }
  118.  Val(ParamStr(4), T, DS );
  119.  If (DS = 0)and( T in [1..2]) Then Density := T;  { Printer Mode }
  120.  Repeat
  121.   ReadLn(Number_IN);
  122.    If Number_IN <> '' Then
  123.     Begin
  124.      Write(Lst,#27+'1');    { Set  7/72 Line Spacing }
  125.       For LC := 1 to Hight Do   {Hight Loop }
  126.        Begin
  127.         For DS := 1 To Passes Do   { Double Strike }
  128.          Begin
  129.           Send_Char('*');     { Must Create a '*' @ start & end }
  130.           For L := 1 To Byte(Number_IN[0]) Do Send_Char(Number_IN [ L ]);
  131.           Send_Char('*');
  132.           Write(Lst,#13);
  133.          End;
  134.         If Lc < Hight Then WriteLn(Lst) else WriteLn(Lst,#27,'2');
  135.        End;
  136.      { Print Number underneath Bars in center or close to it any ways }
  137.      WriteLn(Lst,' ':Resolution,Number_IN:((Byte(Number_IN[0])*(Resolution Div (Byte(Number_In[0])) div 2))));
  138.     End;
  139. Until Number_In = '';
  140. End.
  141.